Circumplex Model of Affect
Brad Cannell
May 23, 2016
Load packages
# CRAN packages
library(dplyr)
library(ggplot2)
# devtools::install_github("mbcann01/dataclean")
library(dataclean)Load data
load("data/daily_april_2016.RData")
# Sort by case number and date
daily <- dplyr::arrange(daily, case_number, date)
about_data(daily)
#> 1390 observations and 129 variables in the data
The goal of this analysis is to plot participant responses on a circumplex model of affect.
“The circumplex model of emotion was developed by James Russell. This model suggests that emotions are distributed in a two-dimensional circular space, containing arousal and valence dimensions. Arousal represents the vertical axis and valence represents the horizontal axis, while the center of the circle represents a neutral valence and a medium level of arousal.”
Source: BIOPAC Systems, Inc.
Column plots of aggregate emotional responses
x <- names(select(daily, 4:13))
for (var in x) {
plot <- ggplot2::ggplot(daily, ggplot2::aes_string(x = var)) +
ggplot2::geom_bar() +
ggplot2::scale_x_discrete("") +
ggplot2::ggtitle(paste("I Feel", tools::toTitleCase(var), "Right Now")) +
ggplot2::theme_bw()
print(plot)
}
Methods
Give each emotion an x and y value that relates to its quadrant on the CMOA chart, and the strength with which the participant felt that emotion. For example:
Happy is in quadrant 1, so its X value is positive and its Y value is positive when experienced. If the participant Strongly agrees, then the values are positive 2. If the particpant is Neutral, then the values are 0. If the participant Strongly disagrees, then the values are negative 2.
Frustrated is in quadrant 2, so its X value is negative and its Y value is positive when experienced. If the participant Strongly agrees, then X is negative 2 and Y is positive 2.
Plot the relationship between emotion and behaviors and emotion and substance use:
What they were doing right before they took the assessment: other_act, sit_act, sleep_act, stand_act, walk_act, talk_act
What they did yesterday: bike_yest, run_yest, cleaning_yest, non_yest, min_walk_c, min_run_c, min_act_c, min_sit_c,
Substance use yesterday: alc_sub, cig_sub, mar_sub, opi_sub, stim_sub, herb_sub, other_sub, none_sub
# For emotions in quadrant 1
quad1 <- function(x) {
new <- NA
new[x == "Strongly disagree"] <- -2
new[x == "Disagree"] <- -1
new[x == "Neutral"] <- 0
new[x == "Agree"] <- 1
new[x == "Strongly agree"] <- 2
return(new)
}
# For emotions in quadrant 2
quad2x <- function(x) {
new <- NA
new[x == "Strongly disagree"] <- 2
new[x == "Disagree"] <- 1
new[x == "Neutral"] <- 0
new[x == "Agree"] <- -1
new[x == "Strongly agree"] <- -2
return(new)
}
quad2y <- function(x) {
new <- NA
new[x == "Strongly disagree"] <- -2
new[x == "Disagree"] <- -1
new[x == "Neutral"] <- 0
new[x == "Agree"] <- 1
new[x == "Strongly agree"] <- 2
return(new)
}
# For emotions in quadrant 3
quad3 <- function(x) {
new <- NA
new[x == "Strongly disagree"] <- 2
new[x == "Disagree"] <- 1
new[x == "Neutral"] <- 0
new[x == "Agree"] <- -1
new[x == "Strongly agree"] <- -2
return(new)
}
# For emotions in quadrant 4
quad4x <- function(x) {
new <- NA
new[x == "Strongly disagree"] <- -2
new[x == "Disagree"] <- -1
new[x == "Neutral"] <- 0
new[x == "Agree"] <- 1
new[x == "Strongly agree"] <- 2
return(new)
}
quad4y <- function(x) {
new <- NA
new[x == "Strongly disagree"] <- 2
new[x == "Disagree"] <- 1
new[x == "Neutral"] <- 0
new[x == "Agree"] <- -1
new[x == "Strongly agree"] <- -2
return(new)
}
# Create x and y coordinates for each row
daily <- daily %>%
mutate(
x_happy = ifelse(date_match == 1, quad1(happy_lag), NA),
y_happy = ifelse(date_match == 1, quad1(happy_lag), NA),
x_frustrated = ifelse(date_match == 1, quad2x(frustrated_lag), NA),
y_frustrated = ifelse(date_match == 1, quad2y(frustrated_lag), NA),
x_sad = ifelse(date_match == 1, quad3(sad_lag), NA),
y_sad = ifelse(date_match == 1, quad3(sad_lag), NA),
x_worried = ifelse(date_match == 1, quad2x(worried_lag), NA),
y_worried = ifelse(date_match == 1, quad2y(worried_lag), NA),
x_restless = ifelse(date_match == 1, quad2x(restless_lag), NA),
y_restless = ifelse(date_match == 1, quad2y(restless_lag), NA),
x_excited = ifelse(date_match == 1, quad1(excited_lag), NA),
y_excited = ifelse(date_match == 1, quad1(excited_lag), NA),
x_calm = ifelse(date_match == 1, quad4x(calm_lag), NA),
y_calm = ifelse(date_match == 1, quad4y(calm_lag), NA),
x_lonely = ifelse(date_match == 1, quad3(lonely_lag), NA),
y_lonely = ifelse(date_match == 1, quad3(lonely_lag), NA),
x_bored = ifelse(date_match == 1, quad3(bored_lag), NA),
y_bored = ifelse(date_match == 1, quad3(bored_lag), NA),
x_sluggish = ifelse(date_match == 1, quad3(sluggish_lag), NA),
y_sluggish = ifelse(date_match == 1, quad3(sluggish_lag), NA)
)
# Aggregate across all X values
daily <- daily %>%
mutate(
x = x_happy + x_frustrated + x_sad + x_worried + x_restless + x_excited + x_calm + x_lonely + x_bored + x_sluggish,
y = y_happy + y_frustrated + y_sad + y_worried + y_restless + y_excited + y_calm + y_lonely + y_bored + y_sluggish
)
# Data check:
# View(daily[c("case_number", "date", "date_yest", "date_lag", "date_match", "happy", "alc_sub", "happy_lag", "x_happy", "y_happy", "x")])Plot the relationship between emotion and substance use as a CMOA plot
# Aggregate emotions and any substance use
subs <- select(daily, 90:97) # Grab emotion variables
sub_name <- names(select(daily, 90:97)) # Just names for legend title
i <- 1
for (sub in subs) {
p <- ggplot(daily, aes(x = x, y = y, col = sub)) +
geom_jitter(alpha = 0.6) +
geom_hline(yintercept = 0) + geom_vline(xintercept = 0) +
scale_y_continuous("Arousal") +
scale_x_continuous("Valence") +
scale_color_manual(sub_name[i], values = c("#377EB8", "#E41A1C")) +
ggtitle(paste("Emotions Overall and", sub_name[i])) +
theme_bw()
print(p)
i <- i + 1
}
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
# For each emotion
subs <- select(daily, 90:97) # Grab emotion variables
sub_name <- names(select(daily, 90:97)) # Just names for legend title
x_var <- select(daily, seq(130, 148, by = 2)) # all the x_ variables
y_var <- select(daily, seq(131, 149, by = 2)) # all the y_ variables
title <- c("Happy", "Frustrated", "Sad", "Worried", "Restless", "Excited", "Calm", "Lonely", "Bored", "Sluggish")
i <- 1
for (sub in subs) { # Substances
for (j in 1:length(x_var)){ # Emotions
p <- ggplot(daily, aes(x = x_var[j], y = y_var[j], col = sub)) +
geom_jitter(alpha = 0.6) +
geom_hline(yintercept = 0) + geom_vline(xintercept = 0) +
scale_y_continuous("Arousal") +
scale_x_continuous("Valence") +
scale_color_manual(sub_name[i], values = c("#377EB8", "#E41A1C")) +
ggtitle(paste(title[j], "and", sub_name[i])) +
theme_bw()
print(p)
}
i <- i + 1
}
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
#> Warning: Removed 469 rows containing missing values (geom_point).
Issues
It could be somewhat flawed by the fact that it treats all areas WITHIN each quadrant as equivalent.
We also don’t have an equivalent number of emotions from each quadrant.
May be more informative to limit to “users”. Some people will not use at all; however, among those that do use, XYZ is a predictor.
Clean up
rm(x, var, plot)Session Info:
#> R version 3.3.0 (2016-05-03)
#> Platform: x86_64-apple-darwin13.4.0 (64-bit)
#> Running under: OS X 10.11.5 (El Capitan)
#>
#> locale:
#> [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
#>
#> attached base packages:
#> [1] stats graphics grDevices utils datasets methods base
#>
#> other attached packages:
#> [1] dataclean_0.1.0 ggplot2_2.1.0 dplyr_0.4.3
#>
#> loaded via a namespace (and not attached):
#> [1] Rcpp_0.12.4 digest_0.6.9 assertthat_0.1 plyr_1.8.3
#> [5] grid_3.3.0 R6_2.1.2 gtable_0.2.0 DBI_0.4-1
#> [9] formatR_1.3 magrittr_1.5 scales_0.4.0 evaluate_0.9
#> [13] stringi_1.0-1 lazyeval_0.1.10 rmarkdown_0.9.6 labeling_0.3
#> [17] tools_3.3.0 stringr_1.0.0 munsell_0.4.3 yaml_2.1.13
#> [21] parallel_3.3.0 colorspace_1.2-6 htmltools_0.3.5 knitr_1.12.3